Developer CD Series 1992 June: ROMin Holiday/ADC Developer CD (1992-06) (''ROMin Holiday'')_iso/Developer Connection - 06-1992.iso/Tools & Apps/OS⁄Toolbox/MDEF (LS Pascal)/Pat Menu Demo main

Text File | 1990-04-10 | 10.4 KB | 483 lines | [TEXT/PJMM]

program pat_menu_demo;

    uses
        UDPInstall, utilities, mdef;

    const
        WindowID = 300;
        AboutID = 1000;
        MYPATLIST = 1000;
        QuitItem = 1;
        active = 0;
        inactive = 255;
        AppleID = 150;
        FileID = 151;
        EditID = 152;
        GraphicID = 153;
        UndoItem = 1;
        CutItem = 3;
        CopyItem = 4;
        PasteItem = 5;
        ClearItem = 6;

    var
        aWindow: WindowPtr;
        AppleMenu: MenuHandle;
        FileMenu: MenuHandle;
        EditMenu: MenuHandle;
        GraphicMenu: MenuHandle;
        testPattern: Pattern;
        theEvent: EventRecord;
        Finished: Boolean;
        quitonwindclose: Boolean;
        changeFlag: longint;
        aboutW: WindowPtr;
        aRect, cRect: Rect;
        aStr: Str255;
        aboutEvt: EventRecord;
        aboutDone: Boolean;


    procedure drawabout;

    begin        { Draw the contents of the "About..." window }
        TextFont(0);
        TextSize(12);
        aStr := 'A Pattern Menu Demo ';
        TextFace([condense]);
        MoveTo(((aboutW^.portRect.right) - StringWidth(aStr)) div 2, 32);
        DrawString(aStr);
        TextFace([]);
        TextFont(3);
        TextSize(9);
        aStr := 'by Galen Babcock    Translated from Lightspeed C by David Schwan';
        MoveTo(((aboutW^.portRect.right) - StringWidth(aStr)) div 2, 44);
        DrawString(aStr);
        aStr := 'Written & Compiled with Lightspeed Pascal from THINK Technologies , Inc . ';
        MoveTo(((aboutW^.portRect.right) - StringWidth(aStr)) div 2, 56);
        DrawString(aStr);
        aStr := 'therefore , portions Copyright © 1988 by THINK Technologies , Inc . ';
        MoveTo(((aboutW^.portRect.right) - StringWidth(aStr)) div 2, 68);
        DrawString(aStr);
        aStr := 'Copyright © 1987 by Galen Babcock ';
        MoveTo(aboutW^.portRect.left + 4, aboutW^.portRect.bottom - 4);
        DrawString(aStr);
        aStr := 'Version 1.0 ';
        MoveTo(aboutW^.portRect.right - StringWidth(aStr) - 4, aboutW^.portRect.bottom - 4);
        DrawString(aStr);
    end;

    procedure doabout;

        var
            tempPort: GrafPtr;

    begin        { rather than using a dialog, just create a window to draw the "About..." stuff }
        GetPort(tempPort);
        InitCursor;
        SetRect(aRect, 0, 0, 340, 120);
        centerrect(aRect, screenBits.bounds);
        aboutW := NewWindow(nil, aRect, ' Window ', FALSE, 3, WindowPtr(-1), FALSE, 0);
        SetPort(aboutW);
        zoomport(aboutW, TRUE);
        aboutDone := FALSE;        { do our own event - handling until the}
{ user either clicks the mouse , or presses a key on the keyboard}
        repeat
            begin
                if (GetNextEvent(everyEvent, aboutEvt)) then
                    begin
                        case aboutEvt.what of
                            updateEvt:
                                begin
                                    BeginUpdate(aboutW);
                                    drawabout;
                                    EndUpdate(aboutW);
                                end;

                            keyDown, autoKey, mouseDown:
                                aboutDone := TRUE;

                            otherwise
                                ;
                        end;
                    end;
            end;
        until aboutDone;
        HideWindow(aboutW);
        zoomport(aboutW, FALSE);
        DisposeWindow(aboutW);
        SetPort(tempPort);
    end;

    procedure GracefulExit;

    begin
        ExitToShell;    { just return to Finder on system errors }
    end;

    procedure Init;

        var
            index: integer;

    begin
        MaxApplZone;
        for index := 1 to 11 do
            MoreMasters;
        InitGraf(@thePort);
        InitFonts;
        FlushEvents(everyEvent, 0);
        InitWindows;
        InitMenus;
        TEInit;
        InitDialogs(@GracefulExit);
        InitCursor;
        GetIndPattern(testPattern, MYPATLIST, 1);
        quitonwindclose := TRUE;    { closing application window exits application }
        randSeed := TickCount;
    end;

    procedure UpdateEdit (OnOff: boolean);

        var
            index: integer;

{ if OnOff is true, then enable Edit menu items, otherwise }
{ disable all of the Edit menu items. }

    begin
        for index := 1 to 7 do
            if OnOff then
                EnableItem(EditMenu, index)
            else
                DisableItem(EditMenu, index);
        DisableItem(EditMenu, 2);
    end;

    procedure makemenus;

    begin
        AppleMenu := GetMenu(AppleID);
        AddResMenu(AppleMenu, 'DRVR');
        InsertMenu(AppleMenu, 0);
        FileMenu := GetMenu(FileID);
        InsertMenu(FileMenu, 0);
        EditMenu := GetMenu(EditID);
        InsertMenu(EditMenu, 0);
        UpdateEdit(FALSE);
        GraphicMenu := NewMenu(GraphicID, 'Pattern');
{ set the MenuHandle.menuProc to the MDEF #130 in our }
{ resource file }
        InstallDefProc(CurResFile, 'MDEF', 130, @Our_Custom_Menu);
        GraphicMenu^^.menuProc := GetResource('MDEF', 130);
        CalcMenuSize(GraphicMenu);        { calculate how large the menu rectangle is }
        InsertMenu(GraphicMenu, 0);
        DrawMenuBar;
    end;

    procedure makewindow;

        var
            wRect: Rect;
            FontStuff: FontInfo;

    begin
        SetRect(wRect, 0, 0, 220, 150);        { make an application window }
        aWindow := NewWindow(nil, wRect, 'Pattern Demo', FALSE, 8, WindowPtr(-1), TRUE, 0);
        SetPort(aWindow);
        TextFont(0);
        TextSize(12);
        TextFace([bold]);
        TextMode(srcCopy);
        centerwindow(aWindow, screenBits.bounds);
        zoomport(aWindow, TRUE);
    end;

    procedure DoMenu (mChoice: longint);

        var
            MenuID, MenuItem, i: integer;
            accName: Str255;
            tempPort: GrafPtr;

    begin
        MenuID := HiWord(mChoice);
        MenuItem := LoWord(mChoice);
        case MenuID of
            AppleID:
                case MenuItem of
                    1:
                        doabout;

                    otherwise
                        begin
                            GetItem(AppleMenu, MenuItem, accName);
                            i := OpenDeskAcc(accName);
                        end;
                end;

            FileID:
                case MenuItem of
                    QuitItem:
                        Finished := TRUE;
                    otherwise
                        ;
                end;

            EditID:
                if not SystemEdit(MenuItem - 1) then
                    case MenuItem of
                        UndoItem:
                            ;
                        CutItem:
                            ;
                        CopyItem:
                            ;
                        PasteItem:
                            ;
                        ClearItem:
                            ;
                        otherwise
                            ;
                    end;

            GraphicID:
                if MenuItem > 0 then
                    begin
                        GetIndPattern(testPattern, MYPATLIST, MenuItem);
                        GetPort(tempPort);
                        SetPort(aWindow);
                        InvalRect(aWindow^.portRect);
                        SetPort(tempPort);
                    end;

            otherwise
                ;
        end;
        HiliteMenu(0);
    end;

    procedure DoDrag (aPoint: Point;
                                    eventWindow: WindowPtr);

{ drag the application window around within screenBits.bounds }

{ If eventWindow != FrontWindow(), don't bring it to front, this}
{ way a command-drag can move a background window without }
{ bringing it to the front, according to the Macintosh user }
{ interface guidelines }

    begin
        DragWindow(eventWindow, aPoint, screenBits.bounds);
    end;

    procedure DoContent (aPoint: Point;
                                    eventWindow: WindowPtr);

        var
            thePart, index, pole: integer;
            theControl: ControlHandle;
            cRect: Rect;

    begin
        if FrontWindow <> eventWindow then
            SelectWindow(eventWindow)
        else
            GlobalToLocal(aPoint);    { handle any application-specific mousedown events here }
    end;

    procedure dogrow (aPoint: Point;
                                    eventWindow: WindowPtr);

        var
            newSize: longint;
            newWidth, newHeight: integer;
            limitRect: Rect;

    begin
        if FrontWindow <> eventWindow then
            SelectWindow(eventWindow)
        else
            begin
{ set a limit rectangle for minimum and maximum window size }
                SetRect(limitRect, 100, 100, 32700, 32700);
                newSize := GrowWindow(eventWindow, aPoint, limitRect);
                if newSize <> 0 then
                    begin
                        newWidth := LoWord(newSize);
                        newHeight := HiWord(newSize);
                        SizeWindow(eventWindow, newWidth, newHeight, TRUE);
                        InvalRect(eventWindow^.portRect);
                    end;
            end;
    end;

    procedure DoGoAway (aPoint: Point;
                                    eventWindow: WindowPtr);

{ if the global Boolean "quitonwindclose" is set to true, then}
{ closing the application window will also exit the application.}
{ otherwise, the window just goes away.}

    begin
        if (TrackGoAway(eventWindow, aPoint)) then
            Finished := quitonwindclose;
    end;

    procedure handlemousedown;

        var
            mouseWhere: Point;
            whichWindow: WindowPtr;
            Part: integer;

{ we have a mousedown event, find out where the mouse was}
{ clicked, and dispatch to proper mousedown handling routines}

    begin
        Part := FindWindow(theEvent.where, whichWindow);
        case Part of
            inSysWindow:
                SystemClick(theEvent, whichWindow);

            inMenuBar:
                DoMenu(MenuSelect(theEvent.where));

            inDrag:
                DoDrag(theEvent.where, whichWindow);

            inContent:
                DoContent(theEvent.where, whichWindow);

            inGrow:
                dogrow(theEvent.where, whichWindow);

            inGoAway:
                DoGoAway(theEvent.where, whichWindow);

            inZoomIn, inZoomOut:
                if (TrackBox(whichWindow, theEvent.where, Part)) then
                    begin
                        ZoomWindow(whichWindow, Part, TRUE);
                        InvalRect(whichWindow^.portRect);
                    end;

            otherwise
                ;
        end;
    end;

    procedure handlekeydown;

        var
            ch: char;
            chCode: integer;
            menuChoice, newTime: longint;
            charRect: Rect;

{ was the command-key down?  If so, it might be a command key}
{ equivalent for a menu item}

    begin
        ch := char(BitAnd(theEvent.message, charCodeMask));
        if BitAnd(theEvent.modifiers, cmdKey) <> 0 then
            DoMenu(MenuKey(ch))
        else
            ;
    end;

    procedure handleactivate;

        var
            eventWindow: WindowPtr;

    begin
        eventWindow := WindowPtr(theEvent.message);
        SetPort(eventWindow);
        if eventWindow = aWindow then
            begin
                DrawGrowIcon(eventWindow);
                if BitAnd(theEvent.modifiers, activeFlag) <> 0 then
                    begin        { our window just got an activate event }
                        if BitAnd(theEvent.modifiers, changeFlag) <> 0 then
                            UpdateEdit(FALSE);
                    end
                else
                    begin        { our window just got a deactivate event }
                        if BitAnd(theEvent.modifiers, changeFlag) <> 0 then
                            UpdateEdit(TRUE);
                    end;
            end;
    end;

    procedure handleupdate;

        var
            tempPort, thisPort: GrafPtr;
            dummyRect: Rect;

    begin
        GetPort(tempPort);
        thisPort := WindowPtr(theEvent.message);
        SetPort(thisPort);
        if thisPort = aWindow then
            begin
                BeginUpdate(thisPort);
                EraseRect(thisPort^.portRect);
                DrawGrowIcon(thisPort);
{ clip drawing to exclude the scroll bar areas }
{ since our window has a growicon }
                dummyRect := thisPort^.portRect;
                dummyRect.right := dummyRect.right - 15;
                dummyRect.bottom := dummyRect.bottom - 15;
                ClipRect(dummyRect);
{ our application-specific window drawing routines }
                FillRect(thisPort^.portRect, testPattern);
{ after drawing, set the clip region to an }
{ arbitrarily large rectangle }
                SetRect(dummyRect, -32000, -32000, 32000, 32000);
                ClipRect(dummyRect);
                EndUpdate(thisPort);
            end;
        SetPort(tempPort);
    end;

    procedure handleanevent;

{ find out what kind of event occured, and dispatch to the }
{ proper event-handling routines }

    begin
        case theEvent.what of
            mouseDown:
                handlemousedown;

            keyDown, autoKey:
                handlekeydown;

            activateEvt:
                handleactivate;

            updateEvt:
                handleupdate;

            otherwise
                ;
        end;
    end;

begin
    Init;
    makemenus;
    makewindow;
    Finished := FALSE;
    { the event loop }
    while (Finished = FALSE) do
        begin
            SystemTask;
            if (GetNextEvent(everyEvent, theEvent)) then
                handleanevent;
        end;
{    SetCursor(CursHandle(GetCursor(watchCursor)));}
    zoomport(aWindow, FALSE);
end.